home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / rbarlb10.zip / RBARDEMO.PRG < prev    next >
Text File  |  1993-10-28  |  6KB  |  228 lines
  1. *--------------------------------------------------------------------------
  2. * RBarDemo.PRG - Program to demonstrate the use of the functions
  3. *                in the Clipper Library RBarLib
  4. *
  5. * Used functions :
  6. *
  7. *    R_OpnBar ()    - Open   a progress bar
  8. *    R_UpdBar ()    - Update a progress bar
  9. *    R_ClsBar ()    - Close  a progress bar
  10. *    R_Ntx ()    - Index a file with progress indication
  11. *    R_Pack ()    - Pack  a file with progress indication
  12. *
  13. * This demo has been written for Clipper version 5.xx
  14. *
  15. * Compile    :    CLIPPER RBARDEMO /N
  16. *
  17. * Link       :    RTLINK   file RBarDEMO lib RBarLIB    - or -
  18. *        BLINKER  file RBarDEMO lib RBarLIB    - or -
  19. *        EXOSPACE file RBarDEMO lib RBarLIB
  20. *
  21. * Syntax     :  RBarDEMO
  22. *--------------------------------------------------------------------------
  23. * Date       :  28/10/93
  24. *--------------------------------------------------------------------------
  25. * Author     :  Rolf van Gelder
  26. *               Binnenwiertzstraat 27
  27. *               5615 HG  EINDHOVEN
  28. *            THE NETHERLANDS
  29. *
  30. * E-Mail     :  Internet : RCROLF@urc.tue.nl
  31. *               BitNet   : RCROLF@heitue5
  32. *--------------------------------------------------------------------------
  33. * (c) 1993  Rolf van Gelder, All rights reserved
  34. *--------------------------------------------------------------------------
  35.  
  36. *--------------------------------------------------------------------------
  37. * CONSTANTS
  38. *--------------------------------------------------------------------------
  39. #define    K_ESC    27
  40.  
  41. *--------------------------------------------------------------------------
  42. * STATIC CODEBLOCKS
  43. *--------------------------------------------------------------------------
  44.  
  45. *-- Headerline (with clear screen)
  46. STATIC    bHeader := { || Scroll(), DevPos (0,0), ;
  47.                         DevOut ('RBarDemo: Demo program for RBarLib v1.0 - '+;
  48.                                 '28/10/93       (C) 1993  Rolf v Gelder' ), ;
  49.                         DevPos (1,0), ;
  50.                         DevOut ( Replicate ('─',80) ) }
  51.  
  52.  
  53. *--------------------------------------------------------------------------
  54. *
  55. *                          Main function : RBarDemo
  56. *
  57. *--------------------------------------------------------------------------
  58. FUNCTION RBarDemo
  59.  
  60. *-- Main menu
  61. LOCAL    aMenu := { 'Index demo file (with progress bar)', ;
  62.                    'Pack demo file (with progress bar)', ;
  63.                    'Calculate average salary', ;
  64.                    'Print a report to disk (with progress bar)', ;
  65.                    'End of Demo' }
  66.  
  67. LOCAL    nChoice := 1        && Menu choice
  68.  
  69. LOCAL    nPersons        && Counter : number of persons
  70. LOCAL    nSalTot            && Counter : total of salaries
  71.  
  72. LOCAL    aBar := {}        && Progress bar
  73. LOCAL    nRecs            && Number of records in DBF
  74. LOCAL    nRecCount        && Record counter
  75.  
  76. IF IsColor ()
  77.    *-- Set screen color
  78.  
  79.    SetColor ( 'W+/RB' )
  80.  
  81. ENDIF
  82.  
  83.  
  84. *--------------------------------------------------------------------------
  85. * M A I N   P R O G R A M   L O O P
  86. *--------------------------------------------------------------------------
  87. DO WHILE .t.
  88.  
  89.    *-- Display header lines
  90.    Eval ( bHeader )
  91.  
  92.    DevPos ( 3, 31 )
  93.    DevOut ( '-+- MAIN  MENU -+-' )
  94.  
  95.    *-- Draw box
  96.    @5,17 TO 11,62 DOUBLE
  97.  
  98.    *-- Display main menu
  99.    nChoice := AChoice ( 6, 19, 10, 60, aMenu, , , nChoice )
  100.  
  101.    IF LastKey () = K_ESC .or. nChoice = 5
  102.       *-- <Esc> or 'End of Demo'
  103.       EXIT
  104.    ENDIF
  105.  
  106.    *-- Display header lines
  107.    Eval ( bHeader )
  108.  
  109.    DO CASE
  110.    CASE nChoice = 1
  111.       *-- Index demo file
  112.  
  113.       DevPos ( 3, 24 )
  114.       DevOut ( '>>> INDEX  THE DEMO DBF FILE <<<' )
  115.       DevPos ( 5, 0 )
  116.  
  117.       USE DemoDBF NEW
  118.  
  119.       R_Ntx ( 'Upper(Name)', 'DEMONAME', 'Indexing demo file' )
  120.  
  121.       dbCloseAll ()
  122.  
  123.  
  124.    CASE nChoice = 2
  125.       *-- Pack demo file
  126.  
  127.       DevPos ( 3, 25 )
  128.       DevOut ( '>>> PACK THE DEMO DBF FILE <<<' )
  129.       DevPos ( 5, 0 )
  130.  
  131.       USE DemoDBF NEW
  132.  
  133.       R_Pack ( 'Packing demo file' )
  134.  
  135.       dbCloseAll ()
  136.  
  137.  
  138.    CASE nChoice = 3
  139.  
  140.       DevPos ( 3, 22 )
  141.       DevOut ( '>>> CALCULATE THE AVERAGE SALARY <<<' )
  142.       DevPos ( 5, 0 )
  143.  
  144.       nSalTot  := 0            && Total field
  145.       nPersons := 0            && Number of persons
  146.  
  147.       USE DemoDBF NEW
  148.  
  149.       nRecs := LastRec ()
  150.       IF nRecs < 1
  151.          *-- Prevent zero-division
  152.          nRecs := 1
  153.       ENDIF
  154.  
  155.       nRecCount := 0
  156.  
  157.       aBar := R_OpnBar ( ' CALCULATING AVERAGE SALARY ', ;
  158.          nil, nil, nil, 'GR+/B', 'R+/B' )
  159.  
  160.       dbEval ( { || nPersons++, nSalTot += _FIELD->Salary }, ;
  161.                nil, ;
  162.                { || R_UpdBar ( aBar, 100 * ++nRecCount / nRecs ) } )
  163.  
  164.       R_ClsBar ( aBar )
  165.  
  166.       Alert ( 'The average salary = ' + Str ( nSalTot / nPersons, 9, 2 ) )
  167.  
  168.       dbCloseAll ()
  169.  
  170.  
  171.    CASE nChoice = 4
  172.       *-- Print a report to disk (with progress bar)
  173.  
  174.       DevPos ( 3, 15 )
  175.       DevOut ( '>>> PRINT A REPORT TO DISK (WITH PROGRESS BAR) <<<' )
  176.       DevPos ( 5, 0 )
  177.  
  178.       USE DemoDBF NEW
  179.  
  180.       nRecs := LastRec ()
  181.       IF nRecs < 1
  182.          *-- Prevent zero-division
  183.          nRecs := 1
  184.       ENDIF
  185.  
  186.       nRecCount := 0
  187.  
  188.       aBar := R_OpnBar ( ' PRINTING A REPORT ', ' <Esc> = Abort ' )
  189.  
  190.       REPORT FORM DemoFRM ;
  191.          WHILE ( I_Cont() .and. R_UpdBar ( aBar, 100*++nRecCount/nRecs ) ) ;
  192.          TO FILE DemoLst.Txt NOCONSOLE
  193.  
  194.       R_ClsBar ( aBar )
  195.  
  196.       Alert ( 'Report printed to file DEMOLST.TXT.' )
  197.  
  198.       dbCloseAll ()
  199.  
  200.    ENDCASE
  201.  
  202. ENDDO
  203.  
  204. DevPos ( 23, 0 )
  205.  
  206. RETURN nil
  207.  
  208.  
  209. *--------------------------------------------------------------------------
  210. *
  211. * I_Cont : Tests if the <Esc>-key has been pressed while printing
  212. *
  213. *--------------------------------------------------------------------------
  214. FUNCTION I_Cont
  215.  
  216. IF InKey () = K_ESC
  217.  
  218.    IF Alert ( 'Do you want to abort ?', { "NO", "YES" } ) = 2
  219.  
  220.       RETURN .f.
  221.  
  222.    ENDIF
  223.  
  224. ENDIF
  225.  
  226. RETURN .T.    && Continue
  227. *
  228. * EOF RBarDemo.PRG ========================================================